home *** CD-ROM | disk | FTP | other *** search
/ JCSM Shareware Collection 1993 November / JCSM Shareware Collection - 1993-11.iso / cl720 / q4tl16j.lzh / Q4T-DEMO.BAS < prev    next >
BASIC Source File  |  1993-01-13  |  28KB  |  617 lines
  1. '----------------------------------------------------------------------------
  2. '                         **    Q4T-DEMO.BAS    **
  3. '      Demonstration of the capabilities of the Q4Tool Library routines
  4. '     Written for and compiled with Microsoft (R), QuickBASIC  4.00b (C)
  5. '                 By R. J. Crouch  -  June 90/Jan 92/Jun 92
  6. '                     Copyright  -  1990-93  -  CareWare
  7. '                            All Rights Reserved
  8. '----------------------------------------------------------------------------
  9.  
  10. ' For Q4tool v.1.6a
  11.  
  12. REM $INCLUDE: 'Q4T.BI'                            ' Contains declarations for
  13.                                                   '  Ctr() and Delay()
  14. DEFINT A-Z
  15.  
  16. TYPE RegType                                      ' Necessary for the CALL to
  17.    ax    AS INTEGER                               ' QB's Interrupt() routine
  18.    bx    AS INTEGER                               ' used to clear the screen
  19.    cx    AS INTEGER                               ' at end of demo
  20.    dx    AS INTEGER                               ' Generally placed in the
  21.    bp    AS INTEGER                               ' "$INCLUDE:" file
  22.    si    AS INTEGER                               '
  23.    di    AS INTEGER                               '
  24.    flags AS INTEGER                               '
  25. END TYPE                                          '
  26.                                                   
  27. DIM InReg AS RegType, OutReg AS RegType               ' Typed for Interrupt()
  28. DIM Menu(5, 4) AS STRING                        ' Array for BarMenu() routine
  29. DIM ScrnBuf(8) AS STRING * 4000                          ' Room for 9 screens
  30.                                                          '  w/ option base 0
  31. False = 0: True = NOT False                                           ' Flags
  32. CONST CONT = "Press any key to continue"                            ' Prompts
  33. CONST MCONT = "Left mouse button to continue"                       '
  34.  
  35. Menu(0, 0) = "0303020401"          '<== Contains upper limits of each 2nd dim-
  36.                                       ' ension for each 1st dimension of any
  37. Menu(1, 0) = " Menu Item #1 "         ' menu array.  The field for each value
  38. Menu(1, 1) = " Select Item #1 "       ' is 2 characters in length.
  39. Menu(1, 2) = " Do Item #2     "       '
  40. Menu(1, 3) = " Pick Item #3   "       '     1st Dim      1   2   3   4   5
  41.                                       '
  42. Menu(2, 0) = " Item #2 "              '  # of level 2   03  03  02  04  01
  43. Menu(2, 1) = " #1           "         '  menu items
  44. Menu(2, 2) = " Level 2 - #2 "         '        
  45. Menu(2, 3) = " #3           "         ' 2nd dim. of any menu array must be as
  46.                                       ' large as the largest 1st dim. set.
  47. Menu(3, 0) = " Level #1 Item #3 "     ' ie.  since 1st dim. 4 of Menu() has 4
  48. Menu(3, 1) = " Pick Item #1      "    ' 2nd dim. items - Menu() must be DIMed
  49. Menu(3, 2) = " Show This Item #2 "    ' DIM Menu(5, 4) AS STRING
  50.                                       '             |-- largest number of 2nd
  51. Menu(4, 0) = " Selection #4 "         '                 dimension items
  52. Menu(4, 1) = " Sub Menu Item #1  " '<== The window width of the level 2 menu
  53. Menu(4, 2) = " Sub Item #2       "    ' is determined by the length of ele-
  54. Menu(4, 3) = " Sub Level Item #3 "    ' ment 1 of the 2nd dim.  All strings
  55. Menu(4, 4) = " Sub Menu Item #4  "    ' should be as long as the longest item
  56.                                       ' title.  Spaces at start and end of
  57. Menu(5, 0) = " Quit "                 ' string are not required, but present a
  58. Menu(5, 1) = " Exit Menu Demo "       ' better looking menu when highlighting.
  59.  
  60. b1$ = CHR$(221) + " ": b2$ = " " + CHR$(222)                       ' Brackets
  61. cpyr$ = b1$ + "Copyright - 1990-93 - CareWare" + b2$
  62. mpos1$ = b1$ + "Row ## - Col ##" + b2$                         ' Formats for
  63. mpos2$ = b1$ + "Y ###  -  X ###" + b2$                         '  PRINT USING
  64. buttons = 0
  65. prompt$ = CONT: pctr = Ctr(CONT)
  66.  
  67. 'ON KEY(10) GOSUB Terminate                                 ' For programming
  68. 'KEY(10) ON                                                 '  purposes only
  69.  
  70. '----------------------------------------------------------------------------
  71. 'Title Screen
  72. '----------------------------------------------------------------------------
  73.  
  74.    CALL GetVideo(VMode, VPage, VCol, CStrt, CStp, CAtt)
  75.    COLOR 7, 0, 0: CLS
  76.    CALL DoWindow(1, 3, 25, 76, 103, 5, 0, "Q4Tool Demo - Ver. 1.6a", 2)
  77.    CALL PrtScrn(cpyr$, 25, 24, 103)
  78.    CALL DoWindow(3, 13, 16, 56, 15, 5, 3, prompt$, 3)
  79.    FOR row = 5 TO 14
  80.       READ line$: lctr = Ctr(line$) + 1
  81.       IF row < 8 THEN att = 12 ELSE att = 14
  82.       CALL PrtScrn(line$, row, lctr, att)
  83.    NEXT row
  84.    READ line$
  85.    CALL PrtScrn(line$, row + 1, lctr, 10)
  86.    CALL PrtScrn("█▀▀▐ █ █", 21, 11, 103)
  87.    CALL PrtScrn("█▄▄▐▄█▄█", 22, 11, 103)
  88.    CALL PrtScrn("Software", 23, 11, 103)
  89.    CALL PrtScrn("by  R. J. Crouch", 21, 55, 103)
  90.    CALL PrtScrn("Member", 22, 65, 103)
  91.    CALL PrtScrn(" ssociation of  hareware  rofessionals", 23, 33, 103)
  92.    CALL PrtScrn("A", 23, 33, 96)
  93.    CALL PrtScrn("S", 23, 48, 96)
  94.    CALL PrtScrn("P", 23, 58, 96)
  95.    CALL PutScrn(ScrnBuf(0))
  96.    WHILE INKEY$ = "": WEND                       ' Typical wait for key press
  97.    CALL MouseStatus(have)                         ' Check for mouse interrupt
  98.    IF have THEN                                            ' Ask to use mouse
  99.       CALL DoWindow(7, 16, 12, 49, 12, 1, 0, "", 0)
  100.       CALL MouseVersion(ver$)
  101.       FOR row = 9 TO 14
  102.          READ line$
  103.          lcrt = Ctr(line$)
  104.          CALL PrtScrn(line$, row, lctr, 14)
  105.          IF row = 10 THEN
  106.             CALL PrtScrn(ver$, row, lctr + 26, 10)
  107.             CALL PrtScrn(".", row, lctr + 26 + LEN(ver$), 14)
  108.          END IF
  109.       NEXT row
  110.       finish! = TIMER + 30
  111.       DO
  112.          i$ = UCASE$(INKEY$)                                   ' Wait for key
  113.          now! = TIMER                                          '  or 30 sec.
  114.       LOOP UNTIL i$ = "N" OR i$ = "Y" OR now! > finish!
  115.       IF i$ = "Y" THEN                              ' Initialize mouse driver
  116.          CALL MouseReset(buttons)                       ' Return # of buttons
  117.          IF buttons > 0 THEN
  118.             Mouse = True
  119.             prompt$ = MCONT: pctr = Ctr(MCONT)             ' Use mouse prompt
  120.          ELSE
  121.             Mouse = False
  122.          END IF
  123.       ELSE                                                 ' Mouse not wanted
  124.          Mouse = False
  125.       END IF
  126.       CALL PrtScrn(prompt$, 16, pctr, 10)
  127.       CALL Delay(30, 0, Mouse)
  128.    ELSE                                                   ' No mouse detected
  129.       FOR x = 1 TO 6: READ nul$: NEXT x                ' Skip mouse text data
  130.    END IF
  131.    CALL GetScrn(ScrnBuf(0))                         ' Retrieve opening screen
  132.    IF Mouse THEN CALL PrtScrn(b1$ + prompt$ + b2$, 18, pctr - 2, 15)
  133.    CALL Delay(60, 0, Mouse)
  134.    CLS
  135.    CALL DoWindow(8, 14, 9, 53, 13, 5, 3, prompt$, 3)
  136.    FOR row = 11 TO 13
  137.       READ line$: lctr = Ctr(line$)
  138.       CALL PrtScrn(line$, row, lctr, 15)
  139.    NEXT row
  140.    CALL Delay(60, 0, Mouse)
  141.  
  142. '----------------------------------------------------------------------------
  143. 'Frame types and screen save/restore
  144. '----------------------------------------------------------------------------
  145.  
  146.    COLOR 0, 0, 0: CLS
  147.    col = 0: frm = -1: scrn = -1
  148.    bgd = 0: fgd = 15
  149.    FOR row = 2 TO 14 STEP 3
  150.       col = col + 6: bgd = bgd + 1
  151.       frm = frm + 1: fgd = fgd - 1
  152.       watt = (bgd * 16) + fgd
  153.       CALL DoWindow(row, col, 10, 20, watt, frm, 0, "Window", 2)
  154.       scrn = scrn + 1
  155.       CALL PutScrn(ScrnBuf(scrn))                   ' Screen save w/PutScrn()
  156.    NEXT row
  157.    FOR row = 11 TO 2 STEP -3
  158.       col = col + 6: bgd = bgd + 1
  159.       frm = frm + 1: fgd = fgd - 1
  160.       IF frm = 6 THEN frm = 1
  161.       IF bgd = 9 THEN bgd = 1
  162.       watt = (bgd * 16) + fgd
  163.       CALL DoWindow(row, col, 10, 20, watt, frm, 0, "Q4Tool", 3)
  164.       IF scrn < 8 THEN                             ' Save all but last screen
  165.          scrn = scrn + 1
  166.          CALL PutScrn(ScrnBuf(scrn))             ' Save screens for later use
  167.       END IF
  168.    NEXT row
  169.    FOR row = 3 TO 9
  170.       READ line$
  171.       CALL PrtScrn(line$, row, col + 2, 31)
  172.    NEXT row
  173.    CALL PrtScrn(prompt$, 25, pctr, 10)
  174.    CALL Delay(60, 0, Mouse)
  175.    CALL DoWindow(9, 12, 7, 56, 15, 5, 0, "", 3)
  176.    FOR row = 11 TO 13
  177.       READ line$: lctr = Ctr(line$)
  178.       CALL PrtScrn(line$, row, lctr, 10)
  179.    NEXT row
  180.    CALL Delay(60, 0, Mouse)
  181.    FOR show = 7 TO 0 STEP -1
  182.       CALL GetScrn(ScrnBuf(show))                    ' Retrieve saved screens
  183.    NEXT show
  184.    FOR row = 5 TO 7
  185.       CALL PrtScrn("*  Fast  *", row, 11, 16)
  186.    NEXT row
  187.    CALL Delay(2, 0, Mouse)
  188.    CALL DoWindow(10, 12, 7, 56, 15, 5, 0, prompt$, 3)
  189.    FOR row = 12 TO 13
  190.       READ line$: lctr = Ctr(line$)
  191.       CALL PrtScrn(line$, row, lctr, 10)
  192.    NEXT row
  193.    CALL Delay(60, 0, Mouse)
  194.    FOR show = 1 TO 8
  195.       CALL GetScrn(ScrnBuf(show))                ' Screen restore w/GetScrn()
  196.       CALL Delay(.5, 0, Mouse)                   '  half second delay added
  197.    NEXT show
  198.    CALL PrtScrn("Now a three", 5, 58, 31)
  199.    CALL PrtScrn("second pause", 7, 58, 31)
  200.    CALL Delay(3, 0, Mouse)
  201.    FOR show = 8 TO 0 STEP -1
  202.       CALL GetScrn(ScrnBuf(show))
  203.       CALL Delay(.5, 0, Mouse)
  204.    NEXT show
  205.    CALL DoWindow(2, 6, 10, 20, 116, 5, 0, "Q4Tool", 2)
  206.    CALL PrtScrn("*  Next  *", 5, 11, 112)
  207.    CALL PrtScrn("Shadow Styles", 7, 10, 112)
  208.    CALL PrtScrn(prompt$, 25, pctr, 10)
  209.    CALL Delay(60, 0, Mouse)
  210.  
  211. '----------------------------------------------------------------------------
  212. 'Shadowing
  213. '----------------------------------------------------------------------------
  214.  
  215.    CLS
  216.    CALL DoWindow(1, 1, 25, 80, 57, 5, 0, prompt$, 3)
  217.    CALL DoWindow(2, 21, 3, 38, 112, 1, 0, "", 0)
  218.    CALL DoWindow(6, 41, 18, 35, 17, 0, 0, "", 0)
  219.    READ line$: lctr = Ctr(line$)
  220.    CALL PrtScrn(line$, 3, lctr, 117)
  221.    FOR row = 7 TO 19 STEP 6                           ' print boxes w/shadows
  222.       FOR col = 8 TO 43 STEP 35
  223.          shadow = shadow + 1
  224.          back = back + 1
  225.          watt = (back * 16) + 14
  226.          IF row = 19 THEN                                         ' print x's
  227.             IF col = 8 THEN
  228.                FOR r = row TO row + 4
  229.                   CALL PrtScrn(STRING$(34, "x"), r, col - 3, 62)
  230.                NEXT r
  231.             ELSE
  232.                FOR r = row TO row + 4
  233.                   CALL PrtScrn(STRING$(34, "x"), r, col - 1, 30)
  234.                NEXT r
  235.                back = 3
  236.                watt = (back * 16) + 14
  237.             END IF
  238.          END IF
  239.          CALL DoWindow(row, col, 4, 30, watt, frame, shadow, "", 0)
  240.          frame = frame + 1
  241.          FOR x = row + 1 TO row + 2
  242.             READ line$
  243.             CALL PrtScrn(line$, x, col + 5, back * 16)
  244.          NEXT x
  245.       NEXT col
  246.       back = back + 1
  247.    NEXT row
  248.    CALL PutScrn(ScrnBuf(0))
  249.    CALL Delay(60, 0, Mouse)
  250.    CALL DoWindow(8, 9, 10, 62, 14, 5, 0, prompt$, 3)
  251.    FOR row = 10 TO 14
  252.       READ line$: lctr = Ctr(line$)
  253.       IF row < 12 THEN att = 15 ELSE att = 10
  254.       CALL PrtScrn(line$, row, lctr, att)
  255.    NEXT row
  256.    CALL Delay(60, 0, Mouse)
  257.    CALL GetScrn(ScrnBuf(0))
  258.    CALL DoWindow(11, 12, 7, 57, 11, 5, 0, prompt$, 3)
  259.    FOR row = 13 TO 14
  260.       READ line$
  261.       CALL PrtScrn(line$, row, 18, 15)
  262.    NEXT row
  263.    CALL Delay(60, 0, Mouse)
  264.  
  265. '----------------------------------------------------------------------------
  266. 'MenuDemo
  267. '----------------------------------------------------------------------------
  268.  
  269.    COLOR 1, 1, 0: CLS
  270.    DO
  271.       R1 = 2: R2 = 0
  272.       CALL PrtScrn("Use the arrow keys to highlight and press <ENTER> to select.", 12, 10, 31)
  273.       IF Mouse THEN
  274.          CALL PrtScrn("or", 13, 39, 31)
  275.          CALL PrtScrn("Roll your mouse to highlight and press the LEFT button to select.", 14, 8, 31)
  276.       END IF
  277.       shadow = 6                ' the shadowing argument is new with ver. 1.6
  278.       CALL BarMenu(Menu(), 11, 4, 120, 112, 79, shadow, Mouse, R1, R2)
  279.  
  280.       ' Generally placed after this CALL is some type of selectional
  281.       ' trapping.  The following remarked section outlines a brief example
  282.       ' of one type of system.  The number of CASEs required depends on the
  283.       ' number of items per menu level.
  284.       '
  285.       ' SELECT CASE R1                     Level #1
  286.       '    CASE 0
  287.       '       SELECT CASE R2               Level #2
  288.       '          CASE 0
  289.       '             <ESC> key or RIGHT mouse button pressed
  290.       '          CASE ELSE
  291.       '       END SELECT
  292.       '    CASE 1
  293.       '       SELECT CASE R2               Level #2
  294.       '          CASE 1
  295.       '             Do this
  296.       '          CASE 2
  297.       '             Do this instead
  298.       '          Etc...
  299.       '          CASE ELSE
  300.       '       END SELECT
  301.       '    CASE 2
  302.       '       SELECT CASE R2
  303.       '          CASE 1
  304.       '             Now do this
  305.       '          CASE 2
  306.       '             Do this instead
  307.       '          Etc...
  308.       '          CASE ELSE
  309.       '       END SELECT
  310.       '    Etc...
  311.       '    Etc...
  312.       '    CASE ELSE
  313.       ' END SELECT
  314.  
  315.       IF Mouse THEN CALL MouseVisible(0)
  316.       CALL DoWindow(8, 12, 11, 57, 6, 5, 0, prompt$, 3)
  317.       CALL PrtScrn("The following values were returned.", 11, 23, 14)
  318.       CALL PrtScrn("Level 1 menu item is ==>" + STR$(R1), 13, 27, 11)
  319.       CALL PrtScrn("Level 2 menu item is ==>" + STR$(R2), 15, 27, 11)
  320.       CALL Delay(0, 0, Mouse)
  321.       CALL DoWindow(8, 12, 11, 57, 17, 0, 0, "", 0)
  322.    LOOP UNTIL (R1 = 5 AND R2 = 1)
  323.    CLS
  324.    CALL DoWindow(9, 12, 7, 57, 13, 5, 0, prompt$, 3)
  325.    FOR row = 11 TO 12
  326.       READ line$
  327.       CALL PrtScrn(line$, row, 21, 15)
  328.    NEXT row
  329.    CALL Delay(60, 0, Mouse)
  330.  
  331. '----------------------------------------------------------------------------
  332. 'Equipment and System Information
  333. '----------------------------------------------------------------------------
  334.  
  335.    CALL GetDrive(DrvTot, CurDrv, CurDir$)
  336.    Avail& = CurDrv
  337.    CALL DriveSpc(Avail&)
  338.    'CALL GetVideo(VMode, VPage, VCol, CStrt, CStp, CAtt)
  339.    CALL GetDOS(Dver$)
  340.    CALL GetSize("Q4T-DEMO.EXE", FSize&)
  341.    CALL GetComPorts(ComP)
  342.    CALL Get87(got)
  343.    IF got THEN C87$ = "Yes" ELSE C87$ = "No"
  344.    CALL DoWindow(3, 8, 20, 65, 7, 5, 0, "Equipment and System Information", 2)
  345.    CALL PrtScrn(b1$ + prompt$ + b2$, 22, pctr - 2, 7)
  346.    CALL PrtScrn("     The Current Drive:  " + CHR$(CurDrv + 64) + ":", 6, 21, 11)
  347.    CALL PrtScrn("Total Drives Installed: " + STR$(DrvTot), 7, 21, 11)
  348.    CALL PrtScrn("     Current Directory:  " + CurDir$, 8, 21, 11)
  349.    CALL PrtScrn("  Disk Space Available: " + STR$(Avail&) + " Bytes", 9, 21, 11)
  350.    CALL PrtScrn("    Current Video Mode: " + STR$(VMode), 10, 21, 11)
  351.    CALL PrtScrn("    Current Video Page: " + STR$(VPage), 11, 21, 11)
  352.    CALL PrtScrn("     Number of Columns: " + STR$(VCol), 12, 21, 11)
  353.    CALL PrtScrn("     Cursor Start Line: " + STR$(CStrt), 13, 21, 11)
  354.    CALL PrtScrn("      Cursor Stop Line: " + STR$(CStp), 14, 21, 11)
  355.    CALL PrtScrn("      Cursor Attribute: " + STR$(CAtt), 15, 21, 11)
  356.    CALL PrtScrn("   Current DOS Version:  " + Dver$, 16, 21, 11)
  357.    CALL PrtScrn("  Size of Q4T-DEMO.EXE: " + STR$(FSize&) + " Bytes", 17, 21, 11)
  358.    CALL PrtScrn("Number of Serial Ports: " + STR$(ComP), 18, 21, 11)
  359.    CALL PrtScrn(" Coprocessor Installed:  " + C87$, 19, 21, 11)
  360.    CALL Delay(60, 0, Mouse)
  361.    CALL DoWindow(9, 12, 7, 57, 13, 5, 0, prompt$, 3)
  362.    FOR row = 11 TO 12
  363.       READ line$
  364.       CALL PrtScrn(line$, row, 18, 15)
  365.    NEXT row
  366.    CALL Delay(60, 0, Mouse)
  367.    
  368. '----------------------------------------------------------------------------
  369. 'Mouse Services
  370. '----------------------------------------------------------------------------
  371.  
  372.    mver$ = b1$ + "Mouse Driver ver. " + ver$ + "  -  "
  373.    mstat$ = mver$ + "With" + STR$(buttons) + " buttons installed" + b2$
  374.    sctr = Ctr(mstat$)
  375.  
  376.    CLS
  377.    CALL DoWindow(1, 1, 25, 80, 30, 5, 0, "Q4Tool", 2)
  378.    CALL DoWindow(2, 31, 3, 20, 31, 1, 0, "", 0)
  379.    CALL PrtScrn("Mouse Services", 3, 34, 31)
  380.    CALL DoWindow(5, 5, 10, 35, 12, 5, 0, "Mouse State #1", 2)
  381.    CALL DoWindow(7, 14, 3, 18, 12, 1, 0, "", 0)
  382.    CALL DoWindow(5, 42, 10, 35, 12, 5, 0, "Mouse State #2", 2)
  383.    CALL DoWindow(16, 7, 6, 68, 115, 5, 3, "", 0)
  384.    FOR row = 17 TO 20
  385.       READ line$
  386.       CALL PrtScrn(line$, row, 10, 112)
  387.    NEXT row
  388.    CALL PutScrn(ScrnBuf(0))
  389.    IF Mouse THEN
  390.       CALL PrtScrn(mstat$, 25, sctr, 30)
  391.       CALL MouseLimits(6, 6, 13, 38, 1)                 ' -------------------
  392.       CALL MouseLocate(11, 22, 1)                       '
  393.       CALL MouseCursor(9, 7, 30)                        '
  394.       CALL MouseReset(2)                                ' Save mouse state #1
  395.       CALL MouseVisible(1)                              ' Mouse pointer on
  396.       DO
  397.          CALL MouseClick(lft, mid, rgt)                 ' Typical wait for a
  398.       LOOP UNTIL lft OR rgt                             ' mouse button
  399.       IF rgt THEN
  400.          CALL MouseLimits(6, 43, 13, 75, 1)             ' -------------------
  401.          CALL MouseLocate(11, 59, 1)                    '
  402.          CALL MouseCursor(14, 0, 24)                    '
  403.          CALL MouseReset(4)                             ' Save mouse state #2
  404.  
  405.          pos$ = mpos1$: Mode = 1
  406.          DO                                             ' Loop conditional to
  407.             CALL MouseClick(lft, mid, rgt)              ' mouse button
  408.             IF rgt AND switch THEN
  409.                CALL MouseVisible(0)                   ' Turn old cursor off
  410.                CALL MouseReset(5)                     ' Recall mouse state #2
  411.                CALL MouseVisible(1)                   ' Turn new cursor on
  412.                switch = False
  413.             ELSEIF rgt THEN
  414.                CALL MouseVisible(0)                   ' Turn old cursor off
  415.                CALL MouseReset(3)                     ' Recall mouse state #1
  416.                CALL MouseVisible(1)                   ' Turn new cursor on
  417.                CALL PrtScrn("Black Hole", 8, 18, 12)
  418.                switch = True
  419.             END IF
  420.             IF switch THEN                                   ' Mouse state #1
  421.                CALL MouseExclude(7, 14, 9, 31, 1)           ' Black hole area
  422.                CALL MousePosition(mr, mc, 1)                 ' Turn cursor on
  423.                IF mr < 7 OR mr > 9 OR mc < 14 OR mc > 31 THEN ' outside of
  424.                   CALL MouseVisible(1)                        ' excluded area
  425.                END IF
  426.             ELSE                                             ' Mouse state #2
  427.                IF lft THEN                                     ' Toggle modes
  428.                   IF Mode = 0 THEN
  429.                      pos$ = mpos1$: Mode = 1
  430.                   ELSE
  431.                      pos$ = mpos2$: Mode = 0
  432.                   END IF
  433.                END IF
  434.                CALL MousePosition(r, c, Mode)         ' Return mouse position
  435.                LOCATE 14, 50: COLOR 12, 0: PRINT USING pos$; r; c
  436.             END IF
  437.          LOOP UNTIL lft AND switch
  438.       END IF
  439.       CALL MouseVisible(0)
  440.       READ line$, line$
  441.    ELSE                                                 ' Print no mouse text
  442.       CALL PrtScrn("Black Hole", 8, 18, 12)
  443.       CALL DoWindow(21, 7, 4, 68, 12, 1, 0, CONT$, 3)
  444.       FOR row = 22 TO 23
  445.          READ line$: lctr = Ctr(line$)
  446.          CALL PrtScrn(line$, row, lctr, 14)
  447.       NEXT row
  448.       CALL Delay(60, 0, Mouse)
  449.       CALL GetScrn(ScrnBuf(0))
  450.    END IF
  451.    CALL DoWindow(8, 12, 11, 56, 6, 5, 0, prompt$, 3)
  452.    FOR row = 10 TO 16
  453.       READ line$: lctr = Ctr(line$)
  454.       IF row < 12 THEN att = 15 ELSE att = 10
  455.       CALL PrtScrn(line$, row, lctr, att)
  456.    NEXT row
  457.    CALL Delay(60, 0, Mouse)
  458.  
  459. '----------------------------------------------------------------------------
  460. 'Closing
  461. '----------------------------------------------------------------------------
  462.  
  463.    CLS
  464.    CALL DoWindow(1, 1, 25, 80, 71, 5, 0, "Q4Tool Demo - Ver. 1.6a", 2)
  465.    CALL DoWindow(3, 6, 21, 69, 15, 5, 0, "", 3)
  466.    CALL PrtScrn(cpyr$, 25, 24, 71)
  467.    READ line$: lctr = Ctr(line$)
  468.    CALL PrtScrn(line$, 5, lctr, 12)
  469.    FOR row = 7 TO 19
  470.       READ line$: lctr = Ctr(line$)
  471.       CALL PrtScrn(line$, row, lctr, 14)
  472.    NEXT row
  473.    CALL PrtScrn(prompt$, 21, pctr, 10)
  474.    CALL Delay(90, 0, Mouse)
  475.  
  476. '----------------------------------------------------------------------------
  477. Terminate:
  478. '----------------------------------------------------------------------------
  479.   
  480.    IF Mouse THEN CALL MouseReset(0)
  481.  
  482.    ah = 7: al = 0                               ' Example of system Interrupt
  483.    bh = CAtt: bl = 0                            '  to clear a screen (ie. CLS)
  484.    ch = 0: cl = 0                               '  with int 10H function 7H
  485.    dh = 24: dl = 79                             '  (ah = scroll down)
  486.    InReg.ax = (ah * 256) + al                   ' Conversion of high and low
  487.    InReg.bx = (bh * 256) + bl                   '  byte for acceptance by QB
  488.    InReg.cx = (ch * 256) + cl                   '
  489.    InReg.dx = (dh * 256) + dl                   '
  490.    CALL Interrupt(&H10, InReg, OutReg)          ' Returns nothing
  491.  
  492.    END
  493.  
  494.  
  495.    DATA "Welcome to the world of the"
  496.    DATA "Q4Tool Library [Q4T]"
  497.    DATA "═══════════════════════════"," "
  498.    DATA "This program is set up to demonstrate  the"
  499.    DATA "features of the Q4T Library.  This library"
  500.    DATA "is  designed  to  work with Microsoft (R),"
  501.    DATA "QuickBASIC 4.xx (C).   The source code for"
  502.    DATA "this demo is provided so you  can  examine"
  503.    DATA "the  actual  usage  of these Q4T routines."
  504.    DATA "             Shall we begin?"
  505.    DATA "This  program  detects  the presence of a"
  506.    DATA "mouse driver; version no."
  507.    DATA "Do  you wish to use your mouse throughout"
  508.    DATA "this demonstration?"," "
  509.    DATA "               (Y)  -  (N)"
  510.    DATA "First you will see the various windowing"
  511.    DATA "frame  styles and a demonstration of the"
  512.    DATA "screen save and restore routines.       "
  513.    DATA "Q4Tool  offers a"
  514.    DATA "wide variety  of"
  515.    DATA "frame styles."
  516.    DATA "----------------"
  517.    DATA "The window title"
  518.    DATA "can be placed at"
  519.    DATA "top or bottom.  "
  520.    DATA "Each window screen was saved with PutScrn()."
  521.    DATA "We will now use  GetScrn()  and recall those"
  522.    DATA "nine screens.                               "
  523.    DATA "Now  we will add a half second delay and"
  524.    DATA "again recycle through the saved screens."
  525.    DATA "**  Window Shadow Styles  **"
  526.    DATA "left side and bottom"
  527.    DATA "*  black in color  *"
  528.    DATA "right side and bottom"
  529.    DATA "*  black in  color  *"
  530.    DATA "left side and bottom"
  531.    DATA "*   tinted black   *"
  532.    DATA "right side and bottom"
  533.    DATA "*   tinted  black   *"
  534.    DATA "left side and bottom"
  535.    DATA "* shadow character *"
  536.    DATA "right side and bottom"
  537.    DATA "* shadow  character *"
  538.    DATA "So far this demonstration has used  the  following"
  539.    DATA "routines with a combined number of 72 occurrences."," "
  540.    DATA "   MouseStatus() - DoWindow() - PrtScrn()   "
  541.    DATA "   Delay() - PutScrn() - GetScrn() - Ctr()  "
  542.    DATA "Next is a demonstration of the mouse and key"
  543.    DATA "driven pull-down bar menu routine of Q4Tool."
  544.    DATA "Next is a list of equipment and system"
  545.    DATA "information returned by Q4Tool routines."
  546.    DATA "Next will be a demonstration of  the  various"
  547.    DATA "mouse services offered in the Q4Tool Library."
  548.    DATA "The right mouse button will toggle between the separate mouse"
  549.    DATA "states.  While in mouse state #2,  the left mouse button will"
  550.    DATA "toggle  between  modes  for  MousePosition().  While in mouse"
  551.    DATA "state #1, the left mouse button will exit Mouse Services.    "
  552.    DATA "Sorry, but a mouse driver is not detected by this program."
  553.    DATA "A demonstration of the mouse services will not be done."
  554.    DATA "The following routines are used in the mouse"
  555.    DATA "services demonstration.                     ", " "
  556.    DATA "MouseStatus()    MouseReset()     MousePosition()"
  557.    DATA "MouseLocate()    MouseLimits()    MouseVersion() "
  558.    DATA "MouseVisible()   MouseExclude()   MouseCursor()  "
  559.    DATA "MouseClick()                                     "
  560.    DATA "  ==   Q4Tool Library (Q4T)   =="
  561.    DATA "This concludes the short demonstration of the features"
  562.    DATA "offered by the Q4Tool Library.  Nearly  every  routine"
  563.    DATA "in  Q4T  was used in this demo.  Over 2/3 of the lines"
  564.    DATA "of code in this program contain  a  Q4Tool  statement."
  565.    DATA "The  features  offered  in  this library are common to"
  566.    DATA "most programming needs.  The  prototypes  and  a  full"
  567.    DATA "description  of  these  routines are documented in the"
  568.    DATA "file Q4TOOL.DOC.  Information on the object files  and"
  569.    DATA "source codes for the routines in Q4T is also available"
  570.    DATA "in this file.                                         "," "
  571.    DATA "Microsoft is a registered  trademark of the  Microsoft"
  572.    DATA "Corporation.  Good Luck and Enjoy!                    "
  573.  
  574. '============================================================================
  575. '
  576. '      The source code for  this  demonstration  is  quite  simple.  It
  577. '      should, however, give you a better idea as to the practical  use
  578. '      of  the  Q4Tool  Library routines.  Q4T is designed to be a lib-
  579. '      rary containing the routines generally needed most.   The  mouse
  580. '      services, DoWindow, & BarMenu are the backbone of  this library.
  581. '      There's few programs, large  or  small,  that  couldn't  utilize
  582. '      these features.
  583. '
  584. '      The complete Q4Tool Library was originally  distributed  as  the
  585. '      file Q4T16.ZIP and contains the following files:
  586. '
  587. '                Q4T.LIB         Q4T.QLB           Q4T.BI
  588. '                Q4TOOL.DOC      Q4T-DEMO.BAS      Q4T-DEMO.EXE
  589. '                REGISTER.TXT    README.1ST
  590. '
  591. '      Information  on  the availability of the source and object codes
  592. '      for Q4Tool is found in  the  file  Q4TOOL.DOC.  You  can  always
  593. '      obtain the latest version of Q4Tool from CompuServe (R), IBMPRO,
  594. '      LIB 4 (Browse Q4T) or directly from CareWare.
  595. '
  596. '      Q4Tool is copyrighted to the author with all rights reserved and
  597. '      is  distributed  as  a Shareware product.  If you acquire Q4Tool
  598. '      and decide to use its services, beyond a  30 day  trial  period,
  599. '      than a registration fee of $25.00 is required.   This fee,  when
  600. '      paid, entitles you to full usage & support of this product,  and
  601. '      the latest version of Q4Tool and individual QBJ modules on disk.
  602. '
  603. '                                           _______
  604. '                                      ____|__     |                (R)
  605. '      R. J. Crouch                 --|       |    |-------------------
  606. '      CareWare                       |   ____|__  |  Association of
  607. '      10217 Ridge View Dr.           |  |       |_|  Shareware
  608. '      Grass Valley, CA  95945        |__|   o   |    Professionals
  609. '      (916) 477-6024               -----|   |   |---------------------
  610. '      CIS - 74270,516                   |___|___|    MEMBER
  611. '
  612. '
  613. '      Microsoft is registered trademark of the Microsoft Corporation.
  614. '
  615. '============================================================================
  616.  
  617.